home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / cm_mf.arc / CMBASE.MF < prev    next >
Text File  |  1989-01-30  |  29KB  |  689 lines
  1. % The base file for Computer Modern (a supplement to {\tt plain.mf})
  2.  
  3. cmbase:=1; % when |cmbase| is known, this file has been input
  4.  
  5. let cmchar=\; % `|cmchar|' should precede each character
  6. let generate=input; % `|generate|' should follow the parameters
  7.  
  8. autorounding:=0; smoothing:=0; % we do our own rounding
  9. def autorounded = interim autorounding:=2 enddef;
  10.  
  11. newinternal slant,fudge,math_spread,superness,superpull,beak_darkness,ligs;
  12. boolean square_dots,hefty,serifs,
  13.  monospace,variant_g,low_asterisk,math_fitting;
  14.  
  15. boolean dark,dark.dark,skewed,skewed.skewed; % for fast option testing
  16. dark=skewed=false; dark.dark=skewed.skewed=true;
  17.  
  18. vardef Vround primary y = y_:=vround y;
  19.  if y_<min_Vround: min_Vround else: y_ fi enddef;
  20. newinternal y_,min_Vround;
  21.  
  22. vardef serif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  23.   (expr darkness,jut) suffix modifier =
  24.  pickup crisp.nib; numeric bracket_height; pair downward;
  25.  bracket_height=if dark.modifier: 1.5 fi\\ bracket;
  26.  if y$<y$$: y@2=min(y$+bracket_height,y$$);
  27.   top y@1-slab=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  28.   if y@1>y@2: y@2:=y@1; fi
  29.  else: y@2=max(y$-bracket_height,y$$);
  30.   bot y@1+slab=top y@0-eps=tiny.top y$; downward=z$$-z$;
  31.   if y@1<y@2: y@2:=y@1; fi fi
  32.  y@3=y@2; z@3=whatever[z$,z$$];
  33.  if jut<0: z@2+penoffset downward of currentpen =
  34.    z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
  35.   lft x@0=lft x@1=tiny.lft x$l+jut;
  36.   if x@3<x@2+eps: x@3:=x@2+eps; fi
  37.  else: z@2-penoffset downward of currentpen =
  38.    z$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
  39.    rt x@0=rt x@1=tiny.rt x$r+jut;
  40.    if x@3>x@2-eps: x@3:=x@2-eps; fi fi
  41.  pair corner; ypart corner=y@1; corner=z@2+whatever*downward;
  42.  filldraw z@2{z$-z$$}
  43.   ...darkness[corner,.5[z@1,z@2] ]{z@1-z@2}
  44.   ...{jut,0}z@1--z@0--(x$,y@0)--z@3--cycle; % the serif
  45.  labels (@1,@2); enddef;
  46.  
  47. def dish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  48.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  49.  serif($,$$,@,left_darkness,-left_jut) modifier;
  50.  serif($,$$,@@,right_darkness,right_jut) modifier;
  51.  if dish>0: pickup tiny.nib; numeric dish_out,dish_in;
  52.   if y$<y$$: dish_out=bot y$; dish_in=dish_out+dish; let rev_=reverse;
  53.   else: dish_out=top y$; dish_in=dish_out-dish; let rev_=relax; fi
  54.   erase fill rev_
  55.    ((x@1,dish_out)..(x$,dish_in){right}..(x@@1,dish_out)--cycle);
  56.  fi enddef;
  57.  
  58. def nodish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  59.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  60.  serif($,$$,@,left_darkness,-left_jut) modifier;
  61.  serif($,$$,@@,right_darkness,right_jut) modifier; enddef;
  62.  
  63. vardef sloped_serif.l(suffix $,$$,@)(expr darkness,jut,drop) =
  64.  pickup crisp.nib; pos@2(slab,90);
  65.  lft x@0=tiny.lft x$l; rt x@1=tiny.rt x$r; top y@1=tiny.top y$r;
  66.  lft x@2=lft x@0-jut; y@2r=y@1-drop;
  67.  y@0=max(y@2l-bracket,y$$)-eps;
  68.  if drop>0: erase fill z@1--top z@1
  69.    --(x@2r,top y@1)--z@2r--cycle; fi % erase excess at top
  70.  filldraw z@1--z@2r--z@2l{right}
  71.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  72.   ...{down}z@0--(x@1,y@0)--cycle;  % sloped serif
  73.  labels(@0,@1,@2); enddef;
  74.  
  75. vardef sloped_serif.r(suffix $,$$,@)(expr darkness,jut,drop) =
  76.  pickup crisp.nib; pos@2(slab,-90);
  77.  rt x@0=tiny.rt x$r; lft x@1=tiny.lft x$l; bot y@1=tiny.bot y$l;
  78.  rt x@2=rt x@0+jut; y@2r=y@1+drop;
  79.  y@0=min(y@2l+bracket,y$$)+eps;
  80. if drop>0: erase fill z@1--bot z@1
  81.   --(x@2r,bot y@1)--z@2r--cycle; fi % erase excess at bottom
  82.  filldraw z@1--z@2r--z@2l{left}
  83.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  84.   ...{up}z@0--(x@1,y@0)--cycle;  % sloped serif
  85.  labels(@0,@1,@2); enddef;
  86.  
  87. vardef term.l(suffix $,$$)(expr d,t,s)= % ``robust'' sans-serif terminal
  88.  path p_; p_=z$l{d}..tension t..z$$l;
  89.  pair d_; d_=(x$$l-x$l,s*(y$$l-y$l));
  90.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$l<x$$l):
  91.   p_:=z$l{d}..tension atleast t..{d_}z$$l; fi
  92.  p_ enddef;
  93. vardef term.r(suffix $,$$)(expr d,t,s)=
  94.  path p_; p_=z$r{d}..tension t..z$$r;
  95.  pair d_; d_=(x$$r-x$r,s*(y$$r-y$r));
  96.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$r<x$$r):
  97.   p_:=z$r{d}..tension atleast t..{d_}z$$r; fi
  98.  p_ enddef;
  99. def rterm=reverse term enddef;
  100.  
  101. vardef arm(suffix $,$$,@)(expr darkness,jut) =  % arm from |z$| to |z$$|
  102.  x@0=good.x(x$$r-jut); y@0=y$r;
  103.  if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
  104.   z@2=.5[z$l,z@1];
  105.   filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l] ]...z@2
  106.    ---z$l--z$r--z@0--z$$r--cycle; % arm and beak
  107.  else: filldraw z$l--z$r--z@0--z$$r--cycle; fi  % sans-serif arm
  108.  penlabels(@0,@1,@2); enddef;
  109.  
  110. def pi_stroke = pickup fine.nib;
  111.  pos1(hair,0); pos2(vstem,-90); pos3(vstem,-90);
  112.  x1-.5hair=hround -.5hair; x2=2u; x3=w-1.5u;
  113.  y1=x_height-x_height/3.141592653589793; y2=y3; top y3l=x_height;
  114.  filldraw circ_stroke z3e---z2e...{x1-x2,3.14159(y1-y2)}z1e enddef;
  115.  
  116. def bulb(suffix $,$$,$$$) =
  117.  z$$$r=z$$r;
  118.  path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l;
  119.  filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link
  120.  path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle
  121.  filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r
  122.   --z$$r{0,y$$r-y$r}..cycle; % bulb
  123.  enddef;
  124.  
  125. def v_bulb(suffix $,$$)= % |pos$| is known
  126.  y$$+.5curve=x_height+oo; x$$+.5curve=w-u;
  127.  numeric theta; theta=angle(4(x$-x$$),y$-y$$); pos$$(curve,theta+90);
  128.  filldraw z$$l{dir theta}..tension atleast 1 and 1..{down}z$l
  129.   --z$r{up}...{-dir theta}z$$r..cycle;  % bulb
  130.  enddef;
  131.  
  132. def dot(suffix $,$$) =
  133.  filldraw if square_dots: (x$l,y$$l)--(x$r,y$$l)
  134.    --(x$r,y$$r)--(x$l,y$$r)--cycle  % squarish dot
  135.   else: z$l...z$$l...z$r...z$$r...cycle  fi % roundish dot
  136.  enddef;
  137.  
  138. def comma(suffix $,@)(expr dot_size,jut,depth) =
  139.  pickup fine.nib; pos$(dot_size,90);
  140.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  141.   comma_join_:=max(fine.breadth,floor .7dot_size);
  142.   comma_bot_:=max(fine.breadth,floor .5dot_size);
  143.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  144.   pos@2(comma_bot_,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  145.   x@0r=x@1r=x$'r; rt x@2r=good.x(x$-eps);
  146.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  147.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  148.   z@1r=z$r; rt x@2r=hround(x$+.5dot_size+jut)+2eps; x@3=x$-.5u;
  149.   y@2=1/3[y@1,y@3]; bot y@3r=vround(y$-.5dot_size-depth);
  150.   y_:=ypart((z@1{right}...z@2{down}...z@3)
  151.    intersectiontimes (z$l{right}..{left}z$r)); if y_<0: y_:=1; fi
  152.   filldraw z$r{left}..subpath (0,y_) of (z$l{right}..{left}z$r)--cycle; % dot
  153.   filldraw stroke z@1e{right}...z@2e{down}...z@3e; fi  % tail
  154.  penlabels(@1,@2,@3); enddef;
  155.  
  156. def ammoc(suffix $,@)(expr dot_size,jut,depth) = % reversed comma
  157.  pickup fine.nib; pos$(dot_size,90);
  158.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  159.   comma_join_:=max(fine.breadth,floor .7dot_size);
  160.   comma_top_:=max(fine.breadth,floor .5dot_size);
  161.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  162.   pos@2(comma_top_,0); y@0=y$; y@1=y$r; y@2=y@1+depth;
  163.   x@0l=x@1l=x$'l; lft x@2l=good.x(x$+eps);
  164.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  165.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  166.   z@1l=z$l; lft x@2l=hround(x$-.5dot_size-jut)-2eps; x@3=x$+.5u;
  167.   y@2=1/3[y@1,y@3]; top y@3l=vround(y$+.5dot_size+depth);
  168.   y_:=ypart((z@1{left}...z@2{up}...z@3)
  169.    intersectiontimes (z$r{left}..{right}z$l)); if y_<0: y_:=1; fi
  170.   filldraw z$l{right}..subpath (0,y_) of (z$r{left}..{right}z$l)--cycle; % dot
  171.   filldraw stroke z@1e{left}...z@2e{up}...z@3e; fi  % tail
  172.  penlabels(@1,@2,@3); enddef;
  173.  
  174. %%% @ from to %%%% temporary formatting change
  175. vardef diag_in(suffix from,$)(expr sharpness)(suffix $$) =
  176.  pickup tiny.nib; save from_x,y_;
  177.  if y.from>y$: bot else: top fi\\ y_=y$;
  178.  (from_x,y_)=whatever[z.from,z$];
  179.  sharpness[z$,(from_x,y_)]{z$-z.from}
  180.   ...{z$$-z$}z$+sharpness*length(z$-(from_x,y_))*unitvector(z$$-z$) enddef;
  181.  
  182. vardef diag_out(suffix $)(expr sharpness)(suffix $$,to) =
  183.  pickup tiny.nib; save to_x,y_;
  184.  if y.to>y$: bot else: top fi\\ y_=y$;
  185.  (to_x,y_)=whatever[z$$,z.to];
  186.  z$$-sharpness*length(z$$-(to_x,y_))*unitvector(z$$-z$){z$$-z$}
  187.   ...{z.to-z$$}sharpness[z$$,(to_x,y_)] enddef;
  188.  
  189. vardef diag_end(suffix from,$)(expr sharp